home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / heap.com / BADPTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-11  |  2.7 KB  |  100 lines
  1. {*****************************************************************************
  2.  This unit automatically checks for attempts to dereference a nil pointer, or
  3.  any pointer which points outside of the normal Turbo heap (below HeapOrg, or
  4.  above the free list). USE it early, perhaps first, in your USES statement. In
  5.  order for this unit to have an effect, the program it is used in must be
  6.  compiled with a copy of TPC patched by HEAPPAT, and the $P+ compiler
  7.  directive must be specified before each section of source code where checking
  8.  is to occur.
  9.  
  10.  For further information, refer to HEAP.DOC.
  11.  
  12.  Written 7/26/88, Kim Kokkonen, TurboPower Software.
  13.  Compuserve ID 72457,2131
  14.  Copyright (C) TurboPower Software, 1988,1989. All rights reserved.
  15.  
  16.  Version 5.0 3/8/89
  17.    Updated for Turbo Pascal 5.0.
  18. *****************************************************************************}
  19.  
  20. {$R-,S-}
  21.  
  22. unit BadPtr;
  23.  
  24. interface
  25.  
  26. uses
  27.   Dos;
  28.  
  29. const
  30.   DerefInterrupt = $66;           {Change this constant if HEAPPAT has been
  31.                                    changed to use a different interrupt number}
  32.  
  33. var
  34.   HeapBot : Word;                 {Lowest segment of heap}
  35.   HeapTop : Word;                 {Highest segment of heap}
  36.  
  37.   {============================================================}
  38.  
  39. implementation
  40.  
  41. const
  42.   Digits : array[0..$F] of Char = '0123456789ABCDEF';
  43.  
  44. type
  45.   SO = record
  46.          O, S : Word;
  47.        end;
  48.  
  49. var
  50.   SaveExit : Pointer;             {Previous exit handler}
  51.   SaveDerefInt : Pointer;         {Previous value of int 66 vector}
  52.   BadP : Pointer;                 {Contains bad pointer if error}
  53.  
  54.   function HexW(W : Word) : string;
  55.     {-Return hex string for word}
  56.   begin
  57.     HexW[0] := #4;
  58.     HexW[1] := Digits[hi(W) shr 4];
  59.     HexW[2] := Digits[hi(W) and $F];
  60.     HexW[3] := Digits[lo(W) shr 4];
  61.     HexW[4] := Digits[lo(W) and $F];
  62.   end;
  63.  
  64.   function HexPtr(P : Pointer) : string;
  65.     {-Return hex string for pointer}
  66.   begin
  67.     HexPtr := HexW(SO(P).S)+':'+HexW(SO(P).O);
  68.   end;
  69.  
  70.   procedure BadPointer;
  71.     {-Called when a pointer error is detected}
  72.   begin
  73.     WriteLn('Bad pointer (', HexPtr(BadP), ') encountered at ', HexPtr(ErrorAddr));
  74.     WriteLn('Valid heap limits are ', HexW(HeapBot), '-', HexW(HeapTop));
  75.     Halt(1);
  76.   end;
  77.  
  78.   {$L BADPTR}
  79.   procedure CheckBad;
  80.     {-Check for a bad pointer}
  81.   external;
  82.  
  83.   {$F+}
  84.   procedure Cleanup;
  85.     {-Restore interrupt}
  86.   begin
  87.     ExitProc := SaveExit;
  88.     SetIntVec(DerefInterrupt, SaveDerefInt);
  89.   end;
  90.   {$F-}
  91.  
  92. begin
  93.   HeapBot := SO(HeapOrg).S;
  94.   HeapTop := SO(FreePtr).S+$1000;
  95.   GetIntVec(DerefInterrupt, SaveDerefInt);
  96.   SetIntVec(DerefInterrupt, @CheckBad);
  97.   SaveExit := ExitProc;
  98.   ExitProc := @Cleanup;
  99. end.
  100.